home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / src / lib / tcl / dist6.3 / tclExpr.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-03-23  |  33.5 KB  |  1,337 lines
  1. /* 
  2.  * tclExpr.c --
  3.  *
  4.  *    This file contains the code to evaluate expressions for
  5.  *    Tcl.
  6.  *
  7.  *    This implementation of floating-point support was modelled
  8.  *    after an initial implementation by Bill Carpenter.
  9.  *
  10.  * Copyright 1987-1991 Regents of the University of California
  11.  * Permission to use, copy, modify, and distribute this
  12.  * software and its documentation for any purpose and without
  13.  * fee is hereby granted, provided that the above copyright
  14.  * notice appear in all copies.  The University of California
  15.  * makes no representations about the suitability of this
  16.  * software for any purpose.  It is provided "as is" without
  17.  * express or implied warranty.
  18.  */
  19.  
  20. #ifndef lint
  21. static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclExpr.c,v 1.35 92/03/23 09:53:46 ouster Exp $ SPRITE (Berkeley)";
  22. #endif
  23.  
  24. #include "tclInt.h"
  25.  
  26. /*
  27.  * The stuff below is a bit of a hack so that this file can be used
  28.  * in environments that include no UNIX, i.e. no errno.  Just define
  29.  * errno here.
  30.  */
  31.  
  32. #ifndef TCL_GENERIC_ONLY
  33. #include "tclUnix.h"
  34. #else
  35. int errno;
  36. #define ERANGE 34
  37. #endif
  38.  
  39. /*
  40.  * The data structure below is used to describe an expression value,
  41.  * which can be either an integer (the usual case), a double-precision
  42.  * floating-point value, or a string.  A given number has only one
  43.  * value at a time.
  44.  */
  45.  
  46. #define STATIC_STRING_SPACE 150
  47.  
  48. typedef struct {
  49.     long intValue;        /* Integer value, if any. */
  50.     double  doubleValue;    /* Floating-point value, if any. */
  51.     ParseValue pv;        /* Used to hold a string value, if any. */
  52.     char staticSpace[STATIC_STRING_SPACE];
  53.                 /* Storage for small strings;  large ones
  54.                  * are malloc-ed. */
  55.     int type;            /* Type of value:  TYPE_INT, TYPE_DOUBLE,
  56.                  * or TYPE_STRING. */
  57. } Value;
  58.  
  59. /*
  60.  * Valid values for type:
  61.  */
  62.  
  63. #define TYPE_INT    0
  64. #define TYPE_DOUBLE    1
  65. #define TYPE_STRING    2
  66.  
  67.  
  68. /*
  69.  * The data structure below describes the state of parsing an expression.
  70.  * It's passed among the routines in this module.
  71.  */
  72.  
  73. typedef struct {
  74.     char *originalExpr;        /* The entire expression, as originally
  75.                  * passed to Tcl_Expr. */
  76.     char *expr;            /* Position to the next character to be
  77.                  * scanned from the expression string. */
  78.     int token;            /* Type of the last token to be parsed from
  79.                  * expr.  See below for definitions.
  80.                  * Corresponds to the characters just
  81.                  * before expr. */
  82. } ExprInfo;
  83.  
  84. /*
  85.  * The token types are defined below.  In addition, there is a table
  86.  * associating a precedence with each operator.  The order of types
  87.  * is important.  Consult the code before changing it.
  88.  */
  89.  
  90. #define VALUE        0
  91. #define OPEN_PAREN    1
  92. #define CLOSE_PAREN    2
  93. #define END        3
  94. #define UNKNOWN        4
  95.  
  96. /*
  97.  * Binary operators:
  98.  */
  99.  
  100. #define MULT        8
  101. #define DIVIDE        9
  102. #define MOD        10
  103. #define PLUS        11
  104. #define MINUS        12
  105. #define LEFT_SHIFT    13
  106. #define RIGHT_SHIFT    14
  107. #define LESS        15
  108. #define GREATER        16
  109. #define LEQ        17
  110. #define GEQ        18
  111. #define EQUAL        19
  112. #define NEQ        20
  113. #define BIT_AND        21
  114. #define BIT_XOR        22
  115. #define BIT_OR        23
  116. #define AND        24
  117. #define OR        25
  118. #define QUESTY        26
  119. #define COLON        27
  120.  
  121. /*
  122.  * Unary operators:
  123.  */
  124.  
  125. #define    UNARY_MINUS    28
  126. #define NOT        29
  127. #define BIT_NOT        30
  128.  
  129. /*
  130.  * Precedence table.  The values for non-operator token types are ignored.
  131.  */
  132.  
  133. int precTable[] = {
  134.     0, 0, 0, 0, 0, 0, 0, 0,
  135.     11, 11, 11,                /* MULT, DIVIDE, MOD */
  136.     10, 10,                /* PLUS, MINUS */
  137.     9, 9,                /* LEFT_SHIFT, RIGHT_SHIFT */
  138.     8, 8, 8, 8,                /* LESS, GREATER, LEQ, GEQ */
  139.     7, 7,                /* EQUAL, NEQ */
  140.     6,                    /* BIT_AND */
  141.     5,                    /* BIT_XOR */
  142.     4,                    /* BIT_OR */
  143.     3,                    /* AND */
  144.     2,                    /* OR */
  145.     1, 1,                /* QUESTY, COLON */
  146.     12, 12, 12                /* UNARY_MINUS, NOT, BIT_NOT */
  147. };
  148.  
  149. /*
  150.  * Mapping from operator numbers to strings;  used for error messages.
  151.  */
  152.  
  153. char *operatorStrings[] = {
  154.     "VALUE", "(", ")", "END", "UNKNOWN", "5", "6", "7",
  155.     "*", "/", "%", "+", "-", "<<", ">>", "<", ">", "<=",
  156.     ">=", "==", "!=", "&", "^", "|", "&&", "||", "?", ":",
  157.     "-", "!", "~"
  158. };
  159.  
  160. /*
  161.  * Declarations for local procedures to this file:
  162.  */
  163.  
  164. static int        ExprGetValue _ANSI_ARGS_((Tcl_Interp *interp,
  165.                 ExprInfo *infoPtr, int prec, Value *valuePtr));
  166. static int        ExprLex _ANSI_ARGS_((Tcl_Interp *interp,
  167.                 ExprInfo *infoPtr, Value *valuePtr));
  168. static void        ExprMakeString _ANSI_ARGS_((Value *valuePtr));
  169. static int        ExprParseString _ANSI_ARGS_((Tcl_Interp *interp,
  170.                 char *string, Value *valuePtr));
  171. static int        ExprTopLevel _ANSI_ARGS_((Tcl_Interp *interp,
  172.                 char *string, Value *valuePtr));
  173.  
  174. /*
  175.  *--------------------------------------------------------------
  176.  *
  177.  * ExprParseString --
  178.  *
  179.  *    Given a string (such as one coming from command or variable
  180.  *    substitution), make a Value based on the string.  The value
  181.  *    will be a floating-point or integer, if possible, or else it
  182.  *    will just be a copy of the string.
  183.  *
  184.  * Results:
  185.  *    TCL_OK is returned under normal circumstances, and TCL_ERROR
  186.  *    is returned if a floating-point overflow or underflow occurred
  187.  *    while reading in a number.  The value at *valuePtr is modified
  188.  *    to hold a number, if possible.
  189.  *
  190.  * Side effects:
  191.  *    None.
  192.  *
  193.  *--------------------------------------------------------------
  194.  */
  195.  
  196. static int
  197. ExprParseString(interp, string, valuePtr)
  198.     Tcl_Interp *interp;        /* Where to store error message. */
  199.     char *string;        /* String to turn into value. */
  200.     Value *valuePtr;        /* Where to store value information. 
  201.                  * Caller must have initialized pv field. */
  202. {
  203.     register char c;
  204.  
  205.     /*
  206.      * Try to convert the string to a number.
  207.      */
  208.  
  209.     c = *string;
  210.     if (((c >= '0') && (c <= '9')) || (c == '-') || (c == '.')) {
  211.     char *term;
  212.  
  213.     valuePtr->type = TYPE_INT;
  214.     errno = 0;
  215.     valuePtr->intValue = strtol(string, &term, 0);
  216.     c = *term;
  217.     if ((c == '\0') && (errno != ERANGE)) {
  218.         return TCL_OK;
  219.     }
  220.     if ((c == '.') || (c == 'e') || (c == 'E') || (errno == ERANGE)) {
  221.         errno = 0;
  222.         valuePtr->doubleValue = strtod(string, &term);
  223.         if (errno == ERANGE) {
  224.         Tcl_ResetResult(interp);
  225.         if (valuePtr->doubleValue == 0.0) {
  226.             Tcl_AppendResult(interp, "floating-point value \"",
  227.                 string, "\" too small to represent",
  228.                 (char *) NULL);
  229.         } else {
  230.             Tcl_AppendResult(interp, "floating-point value \"",
  231.                 string, "\" too large to represent",
  232.                 (char *) NULL);
  233.         }
  234.         return TCL_ERROR;
  235.         }
  236.         if (*term == '\0') {
  237.         valuePtr->type = TYPE_DOUBLE;
  238.         return TCL_OK;
  239.         }
  240.     }
  241.     }
  242.  
  243.     /*
  244.      * Not a valid number.  Save a string value (but don't do anything
  245.      * if it's already the value).
  246.      */
  247.  
  248.     valuePtr->type = TYPE_STRING;
  249.     if (string != valuePtr->pv.buffer) {
  250.     int length, shortfall;
  251.  
  252.     length = strlen(string);
  253.     valuePtr->pv.next = valuePtr->pv.buffer;
  254.     shortfall = length - (valuePtr->pv.end - valuePtr->pv.buffer);
  255.     if (shortfall > 0) {
  256.         (*valuePtr->pv.expandProc)(&valuePtr->pv, shortfall);
  257.     }
  258.     strcpy(valuePtr->pv.buffer, string);
  259.     }
  260.     return TCL_OK;
  261. }
  262.  
  263. /*
  264.  *----------------------------------------------------------------------
  265.  *
  266.  * ExprLex --
  267.  *
  268.  *    Lexical analyzer for expression parser:  parses a single value,
  269.  *    operator, or other syntactic element from an expression string.
  270.  *
  271.  * Results:
  272.  *    TCL_OK is returned unless an error occurred while doing lexical
  273.  *    analysis or executing an embedded command.  In that case a
  274.  *    standard Tcl error is returned, using interp->result to hold
  275.  *    an error message.  In the event of a successful return, the token
  276.  *    and field in infoPtr is updated to refer to the next symbol in
  277.  *    the expression string, and the expr field is advanced past that
  278.  *    token;  if the token is a value, then the value is stored at
  279.  *    valuePtr.
  280.  *
  281.  * Side effects:
  282.  *    None.
  283.  *
  284.  *----------------------------------------------------------------------
  285.  */
  286.  
  287. static int
  288. ExprLex(interp, infoPtr, valuePtr)
  289.     Tcl_Interp *interp;            /* Interpreter to use for error
  290.                      * reporting. */
  291.     register ExprInfo *infoPtr;        /* Describes the state of the parse. */
  292.     register Value *valuePtr;        /* Where to store value, if that is
  293.                      * what's parsed from string.  Caller
  294.                      * must have initialized pv field
  295.                      * correctly. */
  296. {
  297.     register char *p, c;
  298.     char *var, *term;
  299.     int result;
  300.  
  301.     p = infoPtr->expr;
  302.     c = *p;
  303.     while (isspace(c)) {
  304.     p++;
  305.     c = *p;
  306.     }
  307.     infoPtr->expr = p+1;
  308.     switch (c) {
  309.     case '0':
  310.     case '1':
  311.     case '2':
  312.     case '3':
  313.     case '4':
  314.     case '5':
  315.     case '6':
  316.     case '7':
  317.     case '8':
  318.     case '9':
  319.     case '.':
  320.  
  321.         /*
  322.          * Number.  First read an integer.  Then if it looks like
  323.          * there's a floating-point number (or if it's too big a
  324.          * number to fit in an integer), parse it as a floating-point
  325.          * number.
  326.          */
  327.  
  328.         infoPtr->token = VALUE;
  329.         valuePtr->type = TYPE_INT;
  330.         errno = 0;
  331.         valuePtr->intValue = strtoul(p, &term, 0);
  332.         c = *term;
  333.         if ((c == '.') || (c == 'e') || (c == 'E') || (errno == ERANGE)) {
  334.         char *term2;
  335.  
  336.         errno = 0;
  337.         valuePtr->doubleValue = strtod(p, &term2);
  338.         if (errno == ERANGE) {
  339.             Tcl_ResetResult(interp);
  340.             if (valuePtr->doubleValue == 0.0) {
  341.             interp->result =
  342.                 "floating-point value too small to represent";
  343.             } else {
  344.             interp->result =
  345.                 "floating-point value too large to represent";
  346.             }
  347.             return TCL_ERROR;
  348.         }
  349.         if (term2 == infoPtr->expr) {
  350.             interp->result = "poorly-formed floating-point value";
  351.             return TCL_ERROR;
  352.         }
  353.         valuePtr->type = TYPE_DOUBLE;
  354.         infoPtr->expr = term2;
  355.         } else {
  356.         infoPtr->expr = term;
  357.         }
  358.         return TCL_OK;
  359.  
  360.     case '$':
  361.  
  362.         /*
  363.          * Variable.  Fetch its value, then see if it makes sense
  364.          * as an integer or floating-point number.
  365.          */
  366.  
  367.         infoPtr->token = VALUE;
  368.         var = Tcl_ParseVar(interp, p, &infoPtr->expr);
  369.         if (var == NULL) {
  370.         return TCL_ERROR;
  371.         }
  372.         if (((Interp *) interp)->noEval) {
  373.         valuePtr->type = TYPE_INT;
  374.         valuePtr->intValue = 0;
  375.         return TCL_OK;
  376.         }
  377.         return ExprParseString(interp, var, valuePtr);
  378.  
  379.     case '[':
  380.         infoPtr->token = VALUE;
  381.         result = Tcl_Eval(interp, p+1, TCL_BRACKET_TERM,
  382.             &infoPtr->expr);
  383.         if (result != TCL_OK) {
  384.         return result;
  385.         }
  386.         infoPtr->expr++;
  387.         if (((Interp *) interp)->noEval) {
  388.         valuePtr->type = TYPE_INT;
  389.         valuePtr->intValue = 0;
  390.         Tcl_ResetResult(interp);
  391.         return TCL_OK;
  392.         }
  393.         result = ExprParseString(interp, interp->result, valuePtr);
  394.         if (result != TCL_OK) {
  395.         return result;
  396.         }
  397.         Tcl_ResetResult(interp);
  398.         return TCL_OK;
  399.  
  400.     case '"':
  401.         infoPtr->token = VALUE;
  402.         result = TclParseQuotes(interp, infoPtr->expr, '"', 0,
  403.             &infoPtr->expr, &valuePtr->pv);
  404.         if (result != TCL_OK) {
  405.         return result;
  406.         }
  407.         return ExprParseString(interp, valuePtr->pv.buffer, valuePtr);
  408.  
  409.     case '{':
  410.         infoPtr->token = VALUE;
  411.         result = TclParseBraces(interp, infoPtr->expr, &infoPtr->expr,
  412.             &valuePtr->pv);
  413.         if (result != TCL_OK) {
  414.         return result;
  415.         }
  416.         return ExprParseString(interp, valuePtr->pv.buffer, valuePtr);
  417.  
  418.     case '(':
  419.         infoPtr->token = OPEN_PAREN;
  420.         return TCL_OK;
  421.  
  422.     case ')':
  423.         infoPtr->token = CLOSE_PAREN;
  424.         return TCL_OK;
  425.  
  426.     case '*':
  427.         infoPtr->token = MULT;
  428.         return TCL_OK;
  429.  
  430.     case '/':
  431.         infoPtr->token = DIVIDE;
  432.         return TCL_OK;
  433.  
  434.     case '%':
  435.         infoPtr->token = MOD;
  436.         return TCL_OK;
  437.  
  438.     case '+':
  439.         infoPtr->token = PLUS;
  440.         return TCL_OK;
  441.  
  442.     case '-':
  443.         infoPtr->token = MINUS;
  444.         return TCL_OK;
  445.  
  446.     case '?':
  447.         infoPtr->token = QUESTY;
  448.         return TCL_OK;
  449.  
  450.     case ':':
  451.         infoPtr->token = COLON;
  452.         return TCL_OK;
  453.  
  454.     case '<':
  455.         switch (p[1]) {
  456.         case '<':
  457.             infoPtr->expr = p+2;
  458.             infoPtr->token = LEFT_SHIFT;
  459.             break;
  460.         case '=':
  461.             infoPtr->expr = p+2;
  462.             infoPtr->token = LEQ;
  463.             break;
  464.         default:
  465.             infoPtr->token = LESS;
  466.             break;
  467.         }
  468.         return TCL_OK;
  469.  
  470.     case '>':
  471.         switch (p[1]) {
  472.         case '>':
  473.             infoPtr->expr = p+2;
  474.             infoPtr->token = RIGHT_SHIFT;
  475.             break;
  476.         case '=':
  477.             infoPtr->expr = p+2;
  478.             infoPtr->token = GEQ;
  479.             break;
  480.         default:
  481.             infoPtr->token = GREATER;
  482.             break;
  483.         }
  484.         return TCL_OK;
  485.  
  486.     case '=':
  487.         if (p[1] == '=') {
  488.         infoPtr->expr = p+2;
  489.         infoPtr->token = EQUAL;
  490.         } else {
  491.         infoPtr->token = UNKNOWN;
  492.         }
  493.         return TCL_OK;
  494.  
  495.     case '!':
  496.         if (p[1] == '=') {
  497.         infoPtr->expr = p+2;
  498.         infoPtr->token = NEQ;
  499.         } else {
  500.         infoPtr->token = NOT;
  501.         }
  502.         return TCL_OK;
  503.  
  504.     case '&':
  505.         if (p[1] == '&') {
  506.         infoPtr->expr = p+2;
  507.         infoPtr->token = AND;
  508.         } else {
  509.         infoPtr->token = BIT_AND;
  510.         }
  511.         return TCL_OK;
  512.  
  513.     case '^':
  514.         infoPtr->token = BIT_XOR;
  515.         return TCL_OK;
  516.  
  517.     case '|':
  518.         if (p[1] == '|') {
  519.         infoPtr->expr = p+2;
  520.         infoPtr->token = OR;
  521.         } else {
  522.         infoPtr->token = BIT_OR;
  523.         }
  524.         return TCL_OK;
  525.  
  526.     case '~':
  527.         infoPtr->token = BIT_NOT;
  528.         return TCL_OK;
  529.  
  530.     case 0:
  531.         infoPtr->token = END;
  532.         infoPtr->expr = p;
  533.         return TCL_OK;
  534.  
  535.     default:
  536.         infoPtr->expr = p+1;
  537.         infoPtr->token = UNKNOWN;
  538.         return TCL_OK;
  539.     }
  540. }
  541.  
  542. /*
  543.  *----------------------------------------------------------------------
  544.  *
  545.  * ExprGetValue --
  546.  *
  547.  *    Parse a "value" from the remainder of the expression in infoPtr.
  548.  *
  549.  * Results:
  550.  *    Normally TCL_OK is returned.  The value of the expression is
  551.  *    returned in *valuePtr.  If an error occurred, then interp->result
  552.  *    contains an error message and TCL_ERROR is returned.
  553.  *    InfoPtr->token will be left pointing to the token AFTER the
  554.  *    expression, and infoPtr->expr will point to the character just
  555.  *    after the terminating token.
  556.  *
  557.  * Side effects:
  558.  *    None.
  559.  *
  560.  *----------------------------------------------------------------------
  561.  */
  562.  
  563. static int
  564. ExprGetValue(interp, infoPtr, prec, valuePtr)
  565.     Tcl_Interp *interp;            /* Interpreter to use for error
  566.                      * reporting. */
  567.     register ExprInfo *infoPtr;        /* Describes the state of the parse
  568.                      * just before the value (i.e. ExprLex
  569.                      * will be called to get first token
  570.                      * of value). */
  571.     int prec;                /* Treat any un-parenthesized operator
  572.                      * with precedence <= this as the end
  573.                      * of the expression. */
  574.     Value *valuePtr;            /* Where to store the value of the
  575.                      * expression.   Caller must have
  576.                      * initialized pv field. */
  577. {
  578.     Interp *iPtr = (Interp *) interp;
  579.     Value value2;            /* Second operand for current
  580.                      * operator.  */
  581.     int operator;            /* Current operator (either unary
  582.                      * or binary). */
  583.     int badType;            /* Type of offending argument;  used
  584.                      * for error messages. */
  585.     int gotOp;                /* Non-zero means already lexed the
  586.                      * operator (while picking up value
  587.                      * for unary operator).  Don't lex
  588.                      * again. */
  589.     int result;
  590.  
  591.     /*
  592.      * There are two phases to this procedure.  First, pick off an initial
  593.      * value.  Then, parse (binary operator, value) pairs until done.
  594.      */
  595.  
  596.     gotOp = 0;
  597.     value2.pv.buffer = value2.pv.next = value2.staticSpace;
  598.     value2.pv.end = value2.pv.buffer + STATIC_STRING_SPACE - 1;
  599.     value2.pv.expandProc = TclExpandParseValue;
  600.     value2.pv.clientData = (ClientData) NULL;
  601.     result = ExprLex(interp, infoPtr, valuePtr);
  602.     if (result != TCL_OK) {
  603.     goto done;
  604.     }
  605.     if (infoPtr->token == OPEN_PAREN) {
  606.  
  607.     /*
  608.      * Parenthesized sub-expression.
  609.      */
  610.  
  611.     result = ExprGetValue(interp, infoPtr, -1, valuePtr);
  612.     if (result != TCL_OK) {
  613.         goto done;
  614.     }
  615.     if (infoPtr->token != CLOSE_PAREN) {
  616.         Tcl_ResetResult(interp);
  617.         sprintf(interp->result,
  618.             "unmatched parentheses in expression \"%.50s\"",
  619.             infoPtr->originalExpr);
  620.         result = TCL_ERROR;
  621.         goto done;
  622.     }
  623.     } else {
  624.     if (infoPtr->token == MINUS) {
  625.         infoPtr->token = UNARY_MINUS;
  626.     }
  627.     if (infoPtr->token >= UNARY_MINUS) {
  628.  
  629.         /*
  630.          * Process unary operators.
  631.          */
  632.  
  633.         operator = infoPtr->token;
  634.         result = ExprGetValue(interp, infoPtr, precTable[infoPtr->token],
  635.             valuePtr);
  636.         if (result != TCL_OK) {
  637.         goto done;
  638.         }
  639.         switch (operator) {
  640.         case UNARY_MINUS:
  641.             if (valuePtr->type == TYPE_INT) {
  642.             valuePtr->intValue = -valuePtr->intValue;
  643.             } else if (valuePtr->type == TYPE_DOUBLE){
  644.             valuePtr->doubleValue = -valuePtr->doubleValue;
  645.             } else {
  646.             badType = valuePtr->type;
  647.             goto illegalType;
  648.             } 
  649.             break;
  650.         case NOT:
  651.             if (valuePtr->type == TYPE_INT) {
  652.             valuePtr->intValue = !valuePtr->intValue;
  653.             } else if (valuePtr->type == TYPE_DOUBLE) {
  654.             /*
  655.              * Theoretically, should be able to use
  656.              * "!valuePtr->intValue", but apparently some
  657.              * compilers can't handle it.
  658.              */
  659.             if (valuePtr->doubleValue == 0.0) {
  660.                 valuePtr->intValue = 1;
  661.             } else {
  662.                 valuePtr->intValue = 0;
  663.             }
  664.             valuePtr->type = TYPE_INT;
  665.             } else {
  666.             badType = valuePtr->type;
  667.             goto illegalType;
  668.             }
  669.             break;
  670.         case BIT_NOT:
  671.             if (valuePtr->type == TYPE_INT) {
  672.             valuePtr->intValue = ~valuePtr->intValue;
  673.             } else {
  674.             badType  = valuePtr->type;
  675.             goto illegalType;
  676.             }
  677.             break;
  678.         }
  679.         gotOp = 1;
  680.     } else if (infoPtr->token != VALUE) {
  681.         goto syntaxError;
  682.     }
  683.     }
  684.  
  685.     /*
  686.      * Got the first operand.  Now fetch (operator, operand) pairs.
  687.      */
  688.  
  689.     if (!gotOp) {
  690.     result = ExprLex(interp, infoPtr, &value2);
  691.     if (result != TCL_OK) {
  692.         goto done;
  693.     }
  694.     }
  695.     while (1) {
  696.     operator = infoPtr->token;
  697.     value2.pv.next = value2.pv.buffer;
  698.     if ((operator < MULT) || (operator >= UNARY_MINUS)) {
  699.         if ((operator == END) || (operator == CLOSE_PAREN)) {
  700.         result = TCL_OK;
  701.         goto done;
  702.         } else {
  703.         goto syntaxError;
  704.         }
  705.     }
  706.     if (precTable[operator] <= prec) {
  707.         result = TCL_OK;
  708.         goto done;
  709.     }
  710.  
  711.     /*
  712.      * If we're doing an AND or OR and the first operand already
  713.      * determines the result, don't execute anything in the
  714.      * second operand:  just parse.  Same style for ?: pairs.
  715.      */
  716.  
  717.     if ((operator == AND) || (operator == OR) || (operator == QUESTY)) {
  718.         if (valuePtr->type == TYPE_DOUBLE) {
  719.         valuePtr->intValue = valuePtr->doubleValue != 0;
  720.         valuePtr->type = TYPE_INT;
  721.         } else if (valuePtr->type == TYPE_STRING) {
  722.         badType = TYPE_STRING;
  723.         goto illegalType;
  724.         }
  725.         if (((operator == AND) && !valuePtr->intValue)
  726.             || ((operator == OR) && valuePtr->intValue)) {
  727.         iPtr->noEval++;
  728.         result = ExprGetValue(interp, infoPtr, precTable[operator],
  729.             &value2);
  730.         iPtr->noEval--;
  731.         } else if (operator == QUESTY) {
  732.         if (valuePtr->intValue != 0) {
  733.             valuePtr->pv.next = valuePtr->pv.buffer;
  734.             result = ExprGetValue(interp, infoPtr, precTable[operator],
  735.                 valuePtr);
  736.             if (result != TCL_OK) {
  737.             goto done;
  738.             }
  739.             if (infoPtr->token != COLON) {
  740.             goto syntaxError;
  741.             }
  742.             value2.pv.next = value2.pv.buffer;
  743.             iPtr->noEval++;
  744.             result = ExprGetValue(interp, infoPtr, precTable[operator],
  745.                 &value2);
  746.             iPtr->noEval--;
  747.         } else {
  748.             iPtr->noEval++;
  749.             result = ExprGetValue(interp, infoPtr, precTable[operator],
  750.                 &value2);
  751.             iPtr->noEval--;
  752.             if (result != TCL_OK) {
  753.             goto done;
  754.             }
  755.             if (infoPtr->token != COLON) {
  756.             goto syntaxError;
  757.             }
  758.             valuePtr->pv.next = valuePtr->pv.buffer;
  759.             result = ExprGetValue(interp, infoPtr, precTable[operator],
  760.                 valuePtr);
  761.         }
  762.         } else {
  763.         result = ExprGetValue(interp, infoPtr, precTable[operator],
  764.             &value2);
  765.         }
  766.     } else {
  767.         result = ExprGetValue(interp, infoPtr, precTable[operator],
  768.             &value2);
  769.     }
  770.     if (result != TCL_OK) {
  771.         goto done;
  772.     }
  773.     if ((infoPtr->token < MULT) && (infoPtr->token != VALUE)
  774.         && (infoPtr->token != END)
  775.         && (infoPtr->token != CLOSE_PAREN)) {
  776.         goto syntaxError;
  777.     }
  778.  
  779.     /*
  780.      * At this point we've got two values and an operator.  Check
  781.      * to make sure that the particular data types are appropriate
  782.      * for the particular operator, and perform type conversion
  783.      * if necessary.
  784.      */
  785.  
  786.     switch (operator) {
  787.  
  788.         /*
  789.          * For the operators below, no strings are allowed and
  790.          * ints get converted to floats if necessary.
  791.          */
  792.  
  793.         case MULT: case DIVIDE: case PLUS: case MINUS:
  794.         if ((valuePtr->type == TYPE_STRING)
  795.             || (value2.type == TYPE_STRING)) {
  796.             badType = TYPE_STRING;
  797.             goto illegalType;
  798.         }
  799.         if (valuePtr->type == TYPE_DOUBLE) {
  800.             if (value2.type == TYPE_INT) {
  801.             value2.doubleValue = value2.intValue;
  802.             value2.type = TYPE_DOUBLE;
  803.             }
  804.         } else if (value2.type == TYPE_DOUBLE) {
  805.             if (valuePtr->type == TYPE_INT) {
  806.             valuePtr->doubleValue = valuePtr->intValue;
  807.             valuePtr->type = TYPE_DOUBLE;
  808.             }
  809.         }
  810.         break;
  811.  
  812.         /*
  813.          * For the operators below, only integers are allowed.
  814.          */
  815.  
  816.         case MOD: case LEFT_SHIFT: case RIGHT_SHIFT:
  817.         case BIT_AND: case BIT_XOR: case BIT_OR:
  818.          if (valuePtr->type != TYPE_INT) {
  819.              badType = valuePtr->type;
  820.              goto illegalType;
  821.          } else if (value2.type != TYPE_INT) {
  822.              badType = value2.type;
  823.              goto illegalType;
  824.          }
  825.          break;
  826.  
  827.         /*
  828.          * For the operators below, any type is allowed but the
  829.          * two operands must have the same type.  Convert integers
  830.          * to floats and either to strings, if necessary.
  831.          */
  832.  
  833.         case LESS: case GREATER: case LEQ: case GEQ:
  834.         case EQUAL: case NEQ:
  835.         if (valuePtr->type == TYPE_STRING) {
  836.             if (value2.type != TYPE_STRING) {
  837.             ExprMakeString(&value2);
  838.             }
  839.         } else if (value2.type == TYPE_STRING) {
  840.             if (valuePtr->type != TYPE_STRING) {
  841.             ExprMakeString(valuePtr);
  842.             }
  843.         } else if (valuePtr->type == TYPE_DOUBLE) {
  844.             if (value2.type == TYPE_INT) {
  845.             value2.doubleValue = value2.intValue;
  846.             value2.type = TYPE_DOUBLE;
  847.             }
  848.         } else if (value2.type == TYPE_DOUBLE) {
  849.              if (valuePtr->type == TYPE_INT) {
  850.             valuePtr->doubleValue = valuePtr->intValue;
  851.             valuePtr->type = TYPE_DOUBLE;
  852.             }
  853.         }
  854.         break;
  855.  
  856.         /*
  857.          * For the operators below, no strings are allowed, but
  858.          * no int->double conversions are performed.
  859.          */
  860.  
  861.         case AND: case OR:
  862.         if (valuePtr->type == TYPE_STRING) {
  863.             badType = valuePtr->type;
  864.             goto illegalType;
  865.         }
  866.         if (value2.type == TYPE_STRING) {
  867.             badType = value2.type;
  868.             goto illegalType;
  869.         }
  870.         break;
  871.  
  872.         /*
  873.          * For the operators below, type and conversions are
  874.          * irrelevant:  they're handled elsewhere.
  875.          */
  876.  
  877.         case QUESTY: case COLON:
  878.         break;
  879.  
  880.         /*
  881.          * Any other operator is an error.
  882.          */
  883.  
  884.         default:
  885.         interp->result = "unknown operator in expression";
  886.         result = TCL_ERROR;
  887.         goto done;
  888.     }
  889.  
  890.     /*
  891.      * If necessary, convert one of the operands to the type
  892.      * of the other.  If the operands are incompatible with
  893.      * the operator (e.g. "+" on strings) then return an
  894.      * error.
  895.      */
  896.  
  897.     switch (operator) {
  898.         case MULT:
  899.         if (valuePtr->type == TYPE_INT) {
  900.             valuePtr->intValue *= value2.intValue;
  901.         } else {
  902.             valuePtr->doubleValue *= value2.doubleValue;
  903.         }
  904.         break;
  905.         case DIVIDE:
  906.         if (valuePtr->type == TYPE_INT) {
  907.             if (value2.intValue == 0) {
  908.             divideByZero:
  909.             interp->result = "divide by zero";
  910.             result = TCL_ERROR;
  911.             goto done;
  912.             }
  913.             valuePtr->intValue /= value2.intValue;
  914.         } else {
  915.             if (value2.doubleValue == 0.0) {
  916.             goto divideByZero;
  917.             }
  918.             valuePtr->doubleValue /= value2.doubleValue;
  919.         }
  920.         break;
  921.         case MOD:
  922.         if (value2.intValue == 0) {
  923.             goto divideByZero;
  924.         }
  925.         valuePtr->intValue %= value2.intValue;
  926.         break;
  927.         case PLUS:
  928.         if (valuePtr->type == TYPE_INT) {
  929.             valuePtr->intValue += value2.intValue;
  930.         } else {
  931.             valuePtr->doubleValue += value2.doubleValue;
  932.         }
  933.         break;
  934.         case MINUS:
  935.         if (valuePtr->type == TYPE_INT) {
  936.             valuePtr->intValue -= value2.intValue;
  937.         } else {
  938.             valuePtr->doubleValue -= value2.doubleValue;
  939.         }
  940.         break;
  941.         case LEFT_SHIFT:
  942.         valuePtr->intValue <<= value2.intValue;
  943.         break;
  944.         case RIGHT_SHIFT:
  945.         /*
  946.          * The following code is a bit tricky:  it ensures that
  947.          * right shifts propagate the sign bit even on machines
  948.          * where ">>" won't do it by default.
  949.          */
  950.  
  951.         if (valuePtr->intValue < 0) {
  952.             valuePtr->intValue =
  953.                 ~((~valuePtr->intValue) >> value2.intValue);
  954.         } else {
  955.             valuePtr->intValue >>= value2.intValue;
  956.         }
  957.         break;
  958.         case LESS:
  959.         if (valuePtr->type == TYPE_INT) {
  960.             valuePtr->intValue =
  961.             valuePtr->intValue < value2.intValue;
  962.         } else if (valuePtr->type == TYPE_DOUBLE) {
  963.             valuePtr->intValue =
  964.             valuePtr->doubleValue < value2.doubleValue;
  965.         } else {
  966.             valuePtr->intValue =
  967.                 strcmp(valuePtr->pv.buffer, value2.pv.buffer) < 0;
  968.         }
  969.         valuePtr->type = TYPE_INT;
  970.         break;
  971.         case GREATER:
  972.         if (valuePtr->type == TYPE_INT) {
  973.             valuePtr->intValue =
  974.             valuePtr->intValue > value2.intValue;
  975.         } else if (valuePtr->type == TYPE_DOUBLE) {
  976.             valuePtr->intValue =
  977.             valuePtr->doubleValue > value2.doubleValue;
  978.         } else {
  979.             valuePtr->intValue =
  980.                 strcmp(valuePtr->pv.buffer, value2.pv.buffer) > 0;
  981.         }
  982.         valuePtr->type = TYPE_INT;
  983.         break;
  984.         case LEQ:
  985.         if (valuePtr->type == TYPE_INT) {
  986.             valuePtr->intValue =
  987.             valuePtr->intValue <= value2.intValue;
  988.         } else if (valuePtr->type == TYPE_DOUBLE) {
  989.             valuePtr->intValue =
  990.             valuePtr->doubleValue <= value2.doubleValue;
  991.         } else {
  992.             valuePtr->intValue =
  993.                 strcmp(valuePtr->pv.buffer, value2.pv.buffer) <= 0;
  994.         }
  995.         valuePtr->type = TYPE_INT;
  996.         break;
  997.         case GEQ:
  998.         if (valuePtr->type == TYPE_INT) {
  999.             valuePtr->intValue =
  1000.             valuePtr->intValue >= value2.intValue;
  1001.         } else if (valuePtr->type == TYPE_DOUBLE) {
  1002.             valuePtr->intValue =
  1003.             valuePtr->doubleValue >= value2.doubleValue;
  1004.         } else {
  1005.             valuePtr->intValue =
  1006.                 strcmp(valuePtr->pv.buffer, value2.pv.buffer) >= 0;
  1007.         }
  1008.         valuePtr->type = TYPE_INT;
  1009.         break;
  1010.         case EQUAL:
  1011.         if (valuePtr->type == TYPE_INT) {
  1012.             valuePtr->intValue =
  1013.             valuePtr->intValue == value2.intValue;
  1014.         } else if (valuePtr->type == TYPE_DOUBLE) {
  1015.             valuePtr->intValue =
  1016.             valuePtr->doubleValue == value2.doubleValue;
  1017.         } else {
  1018.             valuePtr->intValue =
  1019.                 strcmp(valuePtr->pv.buffer, value2.pv.buffer) == 0;
  1020.         }
  1021.         valuePtr->type = TYPE_INT;
  1022.         break;
  1023.         case NEQ:
  1024.         if (valuePtr->type == TYPE_INT) {
  1025.             valuePtr->intValue =
  1026.             valuePtr->intValue != value2.intValue;
  1027.         } else if (valuePtr->type == TYPE_DOUBLE) {
  1028.             valuePtr->intValue =
  1029.             valuePtr->doubleValue != value2.doubleValue;
  1030.         } else {
  1031.             valuePtr->intValue =
  1032.                 strcmp(valuePtr->pv.buffer, value2.pv.buffer) != 0;
  1033.         }
  1034.         valuePtr->type = TYPE_INT;
  1035.         break;
  1036.         case BIT_AND:
  1037.         valuePtr->intValue &= value2.intValue;
  1038.         break;
  1039.         case BIT_XOR:
  1040.         valuePtr->intValue ^= value2.intValue;
  1041.         break;
  1042.         case BIT_OR:
  1043.         valuePtr->intValue |= value2.intValue;
  1044.         break;
  1045.  
  1046.         /*
  1047.          * For AND and OR, we know that the first value has already
  1048.          * been converted to an integer.  Thus we need only consider
  1049.          * the possibility of int vs. double for the second value.
  1050.          */
  1051.  
  1052.         case AND:
  1053.         if (value2.type == TYPE_DOUBLE) {
  1054.             value2.intValue = value2.doubleValue != 0;
  1055.             value2.type = TYPE_INT;
  1056.         }
  1057.         valuePtr->intValue = valuePtr->intValue && value2.intValue;
  1058.         break;
  1059.         case OR:
  1060.         if (value2.type == TYPE_DOUBLE) {
  1061.             value2.intValue = value2.doubleValue != 0;
  1062.             value2.type = TYPE_INT;
  1063.         }
  1064.         valuePtr->intValue = valuePtr->intValue || value2.intValue;
  1065.         break;
  1066.  
  1067.         case COLON:
  1068.         interp->result = "can't have : operator without ? first";
  1069.         result = TCL_ERROR;
  1070.         goto done;
  1071.     }
  1072.     }
  1073.  
  1074.     done:
  1075.     if (value2.pv.buffer != value2.staticSpace) {
  1076.     ckfree(value2.pv.buffer);
  1077.     }
  1078.     return result;
  1079.  
  1080.     syntaxError:
  1081.     Tcl_ResetResult(interp);
  1082.     Tcl_AppendResult(interp, "syntax error in expression \"",
  1083.         infoPtr->originalExpr, "\"", (char *) NULL);
  1084.     result = TCL_ERROR;
  1085.     goto done;
  1086.  
  1087.     illegalType:
  1088.     Tcl_AppendResult(interp, "can't use ", (badType == TYPE_DOUBLE) ?
  1089.         "floating-point value" : "non-numeric string",
  1090.         " as operand of \"", operatorStrings[operator], "\"",
  1091.         (char *) NULL);
  1092.     result = TCL_ERROR;
  1093.     goto done;
  1094. }
  1095.  
  1096. /*
  1097.  *--------------------------------------------------------------
  1098.  *
  1099.  * ExprMakeString --
  1100.  *
  1101.  *    Convert a value from int or double representation to
  1102.  *    a string.
  1103.  *
  1104.  * Results:
  1105.  *    The information at *valuePtr gets converted to string
  1106.  *    format, if it wasn't that way already.
  1107.  *
  1108.  * Side effects:
  1109.  *    None.
  1110.  *
  1111.  *--------------------------------------------------------------
  1112.  */
  1113.  
  1114. static void
  1115. ExprMakeString(valuePtr)
  1116.     register Value *valuePtr;        /* Value to be converted. */
  1117. {
  1118.     int shortfall;
  1119.  
  1120.     shortfall = 150 - (valuePtr->pv.end - valuePtr->pv.buffer);
  1121.     if (shortfall > 0) {
  1122.     (*valuePtr->pv.expandProc)(&valuePtr->pv, shortfall);
  1123.     }
  1124.     if (valuePtr->type == TYPE_INT) {
  1125.     sprintf(valuePtr->pv.buffer, "%ld", valuePtr->intValue);
  1126.     } else if (valuePtr->type == TYPE_DOUBLE) {
  1127.     sprintf(valuePtr->pv.buffer, "%g", valuePtr->doubleValue);
  1128.     }
  1129.     valuePtr->type = TYPE_STRING;
  1130. }
  1131.  
  1132. /*
  1133.  *--------------------------------------------------------------
  1134.  *
  1135.  * ExprTopLevel --
  1136.  *
  1137.  *    This procedure provides top-level functionality shared by
  1138.  *    procedures like Tcl_ExprInt, Tcl_ExprDouble, etc.
  1139.  *
  1140.  * Results:
  1141.  *    The result is a standard Tcl return value.  If an error
  1142.  *    occurs then an error message is left in interp->result.
  1143.  *    The value of the expression is returned in *valuePtr, in
  1144.  *    whatever form it ends up in (could be string or integer
  1145.  *    or double).  Caller may need to convert result.  Caller
  1146.  *    is also responsible for freeing string memory in *valuePtr,
  1147.  *    if any was allocated.
  1148.  *
  1149.  * Side effects:
  1150.  *    None.
  1151.  *
  1152.  *--------------------------------------------------------------
  1153.  */
  1154.  
  1155. static int
  1156. ExprTopLevel(interp, string, valuePtr)
  1157.     Tcl_Interp *interp;            /* Context in which to evaluate the
  1158.                      * expression. */
  1159.     char *string;            /* Expression to evaluate. */
  1160.     Value *valuePtr;            /* Where to store result.  Should
  1161.                      * not be initialized by caller. */
  1162. {
  1163.     ExprInfo info;
  1164.     int result;
  1165.  
  1166.     info.originalExpr = string;
  1167.     info.expr = string;
  1168.     valuePtr->pv.buffer = valuePtr->pv.next = valuePtr->staticSpace;
  1169.     valuePtr->pv.end = valuePtr->pv.buffer + STATIC_STRING_SPACE - 1;
  1170.     valuePtr->pv.expandProc = TclExpandParseValue;
  1171.     valuePtr->pv.clientData = (ClientData) NULL;
  1172.  
  1173.     result = ExprGetValue(interp, &info, -1, valuePtr);
  1174.     if (result != TCL_OK) {
  1175.     return result;
  1176.     }
  1177.     if (info.token != END) {
  1178.     Tcl_AppendResult(interp, "syntax error in expression \"",
  1179.         string, "\"", (char *) NULL);
  1180.     return TCL_ERROR;
  1181.     }
  1182.     return TCL_OK;
  1183. }
  1184.  
  1185. /*
  1186.  *--------------------------------------------------------------
  1187.  *
  1188.  * Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean --
  1189.  *
  1190.  *    Procedures to evaluate an expression and return its value
  1191.  *    in a particular form.
  1192.  *
  1193.  * Results:
  1194.  *    Each of the procedures below returns a standard Tcl result.
  1195.  *    If an error occurs then an error message is left in
  1196.  *    interp->result.  Otherwise the value of the expression,
  1197.  *    in the appropriate form, is stored at *resultPtr.  If
  1198.  *    the expression had a result that was incompatible with the
  1199.  *    desired form then an error is returned.
  1200.  *
  1201.  * Side effects:
  1202.  *    None.
  1203.  *
  1204.  *--------------------------------------------------------------
  1205.  */
  1206.  
  1207. int
  1208. Tcl_ExprLong(interp, string, ptr)
  1209.     Tcl_Interp *interp;            /* Context in which to evaluate the
  1210.                      * expression. */
  1211.     char *string;            /* Expression to evaluate. */
  1212.     long *ptr;                /* Where to store result. */
  1213. {
  1214.     Value value;
  1215.     int result;
  1216.  
  1217.     result = ExprTopLevel(interp, string, &value);
  1218.     if (result == TCL_OK) {
  1219.     if (value.type == TYPE_INT) {
  1220.         *ptr = value.intValue;
  1221.     } else if (value.type == TYPE_DOUBLE) {
  1222.         *ptr = value.doubleValue;
  1223.     } else {
  1224.         interp->result = "expression didn't have numeric value";
  1225.         result = TCL_ERROR;
  1226.     }
  1227.     }
  1228.     if (value.pv.buffer != value.staticSpace) {
  1229.     ckfree(value.pv.buffer);
  1230.     }
  1231.     return result;
  1232. }
  1233.  
  1234. int
  1235. Tcl_ExprDouble(interp, string, ptr)
  1236.     Tcl_Interp *interp;            /* Context in which to evaluate the
  1237.                      * expression. */
  1238.     char *string;            /* Expression to evaluate. */
  1239.     double *ptr;            /* Where to store result. */
  1240. {
  1241.     Value value;
  1242.     int result;
  1243.  
  1244.     result = ExprTopLevel(interp, string, &value);
  1245.     if (result == TCL_OK) {
  1246.     if (value.type == TYPE_INT) {
  1247.         *ptr = value.intValue;
  1248.     } else if (value.type == TYPE_DOUBLE) {
  1249.         *ptr = value.doubleValue;
  1250.     } else {
  1251.         interp->result = "expression didn't have numeric value";
  1252.         result = TCL_ERROR;
  1253.     }
  1254.     }
  1255.     if (value.pv.buffer != value.staticSpace) {
  1256.     ckfree(value.pv.buffer);
  1257.     }
  1258.     return result;
  1259. }
  1260.  
  1261. int
  1262. Tcl_ExprBoolean(interp, string, ptr)
  1263.     Tcl_Interp *interp;            /* Context in which to evaluate the
  1264.                      * expression. */
  1265.     char *string;            /* Expression to evaluate. */
  1266.     int *ptr;                /* Where to store 0/1 result. */
  1267. {
  1268.     Value value;
  1269.     int result;
  1270.  
  1271.     result = ExprTopLevel(interp, string, &value);
  1272.     if (result == TCL_OK) {
  1273.     if (value.type == TYPE_INT) {
  1274.         *ptr = value.intValue != 0;
  1275.     } else if (value.type == TYPE_DOUBLE) {
  1276.         *ptr = value.doubleValue != 0.0;
  1277.     } else {
  1278.         interp->result = "expression didn't have numeric value";
  1279.         result = TCL_ERROR;
  1280.     }
  1281.     }
  1282.     if (value.pv.buffer != value.staticSpace) {
  1283.     ckfree(value.pv.buffer);
  1284.     }
  1285.     return result;
  1286. }
  1287.  
  1288. /*
  1289.  *--------------------------------------------------------------
  1290.  *
  1291.  * Tcl_ExprString --
  1292.  *
  1293.  *    Evaluate an expression and return its value in string form.
  1294.  *
  1295.  * Results:
  1296.  *    A standard Tcl result.  If the result is TCL_OK, then the
  1297.  *    interpreter's result is set to the string value of the
  1298.  *    expression.  If the result is TCL_OK, then interp->result
  1299.  *    contains an error message.
  1300.  *
  1301.  * Side effects:
  1302.  *    None.
  1303.  *
  1304.  *--------------------------------------------------------------
  1305.  */
  1306.  
  1307. int
  1308. Tcl_ExprString(interp, string)
  1309.     Tcl_Interp *interp;            /* Context in which to evaluate the
  1310.                      * expression. */
  1311.     char *string;            /* Expression to evaluate. */
  1312. {
  1313.     Value value;
  1314.     int result;
  1315.  
  1316.     result = ExprTopLevel(interp, string, &value);
  1317.     if (result == TCL_OK) {
  1318.     if (value.type == TYPE_INT) {
  1319.         sprintf(interp->result, "%ld", value.intValue);
  1320.     } else if (value.type == TYPE_DOUBLE) {
  1321.         sprintf(interp->result, "%g", value.doubleValue);
  1322.     } else {
  1323.         if (value.pv.buffer != value.staticSpace) {
  1324.         interp->result = value.pv.buffer;
  1325.         interp->freeProc = (Tcl_FreeProc *) free;
  1326.         value.pv.buffer = value.staticSpace;
  1327.         } else {
  1328.         Tcl_SetResult(interp, value.pv.buffer, TCL_VOLATILE);
  1329.         }
  1330.     }
  1331.     }
  1332.     if (value.pv.buffer != value.staticSpace) {
  1333.     ckfree(value.pv.buffer);
  1334.     }
  1335.     return result;
  1336. }
  1337.